﻿module PrintQuotation

open System
open System.Reflection
open Microsoft.FSharp.Reflection
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.DerivedPatterns
open Component
open Microsoft.Xna.Framework
open Microsoft.Xna.Framework.Graphics
open FSharp_Extensions
open System.Collections.Generic

type String with
  member this.setToVector3List 
    with get() = 
      let splitted_list = this.Split([|",";" , ";", ";", "|], StringSplitOptions.RemoveEmptyEntries);
      seq{
        for el in splitted_list do
          yield el.toVector3
      } |> Seq.toList
  member this.toVector3
    with get () =
      let vector = this.Split([|' '|])
      let P0 = Microsoft.FSharp.Core.float32.Parse(vector.[0], System.Globalization.NumberStyles.Any, System.Globalization.CultureInfo.InvariantCulture)
      let P1 = Microsoft.FSharp.Core.float32.Parse(vector.[1], System.Globalization.NumberStyles.Any, System.Globalization.CultureInfo.InvariantCulture)
      let P2 = Microsoft.FSharp.Core.float32.Parse(vector.[2], System.Globalization.NumberStyles.Any, System.Globalization.CultureInfo.InvariantCulture)
      new Vector3(P0, P1, P2)
  member this.setToFloat32List
    with get() = 
      let splitted_list = this.Split([|" ";"  ";"   ";"    "|], StringSplitOptions.RemoveEmptyEntries)
      seq{
        for el in splitted_list do
          yield Microsoft.FSharp.Core.float32.Parse(el, System.Globalization.NumberStyles.Any, System.Globalization.CultureInfo.InvariantCulture)
      } |> Seq.toList

let difference (left:list< 'a >) (right:list< 'a >) = 
    let cache = HashSet< 'a >(right, HashIdentity.Structural) 
    left |> List.filter (fun n -> not (cache.Contains n))

let intersection (left:list<Expr>) (right:list<Expr>) = 
  let cache = HashSet<Expr>(right, HashIdentity.Structural) 
  left |> List.filter (fun n -> cache.Contains n)

let rec build_expr_list expr =
  match expr with
  |PropertySet (_, _, _, _) -> 
    [expr]
  |Sequential (expr1,expr2) -> (build_expr_list expr1) @ (build_expr_list expr2)


//type MyUnion = A | B
//let uc =
//    let ci = FSharpType.GetUnionCases(typeof<MyUnion>)
//    let c = ci |> Seq.find (fun c -> c.Name = "A")
//    Expr.NewUnionCase(c, [])

//let emptyStringExpr =
//    let ai = FSharpType.GetUnionCases(typeof<List<string>>)
//    let a = ai |> Seq.find(fun c -> c.Name = "Empty")
//    in Expr.NewUnionCase(a,[])
//     
//let consStringExpr value expr =
//  let ci_1 = FSharpType.GetUnionCases(typeof<List<string>>)
//  let c_1 = ci_1 |> Seq.find(fun c -> c.Name = "Cons")
//  in Expr.NewUnionCase(c_1,[Expr.Value(value);expr])  
//
//let build_expr_from_movingBounds_list (mbLst:MovingBounds list) : Expr =
//  let revStringList = (List.rev mbLst) |> List.map (fun mb -> mb.position)
//  //rovescio la lista in quanto la lista di expr deve essere costruita partendo dall'ultimo elemento della lista
//  //in maniera tale da avere la lista generata identica inteso come ordine alla lista di partenza
//  revStringList |> List.fold (fun expr mb -> consStringExpr mb expr) emptyStringExpr 

let rec print_tuple_type (args:Type[]) =
  let mutable start = "("
  start <- start + (print_type args.[0])
  for i in 1..args.Length-1 do
    start <- start + " * " + (print_type args.[i])
  start <- start + ")"
  start

and print_type (t:Type) =
  let mutable start = t.Name.Split([|'`'|]).[0]
  if start = "Tuple" then 
    print_tuple_type (t.GetGenericArguments())
  else
    if t.IsGenericType then
      let args = t.GetGenericArguments()
      start <- start + "<"
      start <- start + (print_type args.[0])
      for i in 1..args.Length-1 do
        start <- start + ", " + (print_type args.[i])
      start <- start + ">"
      start
    else if t.Name = "Single" then
      "float32"
    else
      start
type a = { b:int}
let println expr =
    let rec print first_let tabs expr =
        match expr with
        | Application(expr1, expr2) ->
            sprintf "("
            + print true (tabs+"  ") expr1
            + sprintf " "
            + print true (tabs+"  ") expr2
            + sprintf ")"
        | SpecificCall <@@ (+) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " + "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (-) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " - "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (<) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " < "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (>) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " > "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (>=) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " >= "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (<>) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " <> "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | SpecificCall <@@ (:=) @@> (_, _, exprList) ->
            sprintf "("
            + print true (tabs+"  ") exprList.Head
            + sprintf " := "
            + print true (tabs+"  ") exprList.Tail.Head
            + sprintf ")"
        | Call(None, methodInfo, [a;b]) when methodInfo.Name = "op_EqualsGreater" ->
            sprintf "("
            + print true (tabs+"  ") a
            + sprintf " => "
            + print true (tabs+"  ") b
            + sprintf ")"
        | Call(None, methodInfo, [a;b]) when methodInfo.Name = "op_ColonEquals" ->
            sprintf "("
            + print true (tabs+"  ") a
            + sprintf " := "
            + print true (tabs+"  ") b
            + sprintf ")"
        | Call(None, methodInfo, [x]) when methodInfo.Name = "op_Dereference" ->
            sprintf "(!("
            + print true (tabs+"  ") x
            + sprintf "))"
        | Call(exprOpt, methodInfo, exprList) ->
            match exprOpt with
            | Some expr -> print true (tabs+"  ") expr
            | None -> sprintf "%s" methodInfo.DeclaringType.Name
            + sprintf ".%s(" methodInfo.Name
            + if (exprList.IsEmpty) then 
                sprintf ")" 
              else
                let mutable acc = print true "" exprList.Head
                for expr in exprList.Tail do
                    acc <- acc + sprintf ","
                    acc <- acc + print true (tabs+"  ") expr
                acc + sprintf ")"
        | Int32(n) ->
            sprintf "%d" n
        | Lambda(param, body) ->

            sprintf "("
            + sprintf "fun (%s:%s) ->" param.Name (print_type param.Type)
            + print true (tabs+"  ") body
            + sprintf ")"
        | Let(var, expr1, expr2) ->
            (if (var.IsMutable) then
                sprintf "\n%slet mutable %s = " tabs var.Name
             else
                let var_decl = if FSharpType.IsFunction (var.Type) || true then sprintf "%s" var.Name
                               else sprintf "(%s:%s)" var.Name (print_type var.Type)
                in 
                  if first_let then 
                    sprintf "\n%slet rec %s = " tabs var_decl
                  else
                    sprintf "\n%sand %s = " tabs var_decl)
            + print true (tabs+"  ") expr1
            + sprintf "\n%s" tabs
            + print false tabs expr2
        | LetRecursive([var, expr1], expr2) ->
            (if first_let then 
               sprintf "\n%slet rec %s = " tabs var.Name
             else
               sprintf "\n%sand %s = " tabs var.Name)
            + print true tabs expr1
            + sprintf "\n%s" tabs
            + print false tabs expr2
        | PropertyGet(None, propOrValInfo, _) ->
            sprintf "%s" propOrValInfo.PropertyType.Name + "." + propOrValInfo.Name
        | PropertyGet(Some(e), propOrValInfo, _) ->
            //sprintf "(("
            print true tabs e
            + sprintf ".%s" propOrValInfo.Name
            //+ sprintf "):%s)" (print_type expr.Type)
        | String(str) ->
            sprintf "\"%s\"" str        
        | Var(var) ->
              (sprintf "%s" var.Name)
        | NewObject(ci, args) ->
            sprintf "new %s(" (print_type ci.DeclaringType)
            + if (args.IsEmpty) then 
                sprintf ")" 
              else
                let mutable acc = print true tabs args.Head                
                for expr in args.Tail do
                  acc <- acc + sprintf ","                  
                  acc <- acc + print true tabs expr
                acc + sprintf ")"
        | Coerce(e,t) ->
            sprintf "("
            + print true tabs e
            + if t.Name <> "Object" then sprintf " :?> " else sprintf " :> "
            + sprintf "%s" (print_type t)
            + sprintf ")"
        | PropertySet(me, pi, [], arg) ->
            match me with
            | Some(e) ->  
              print true tabs e
              + sprintf "."
            | None -> ""
            + sprintf "%s <- " pi.Name
            + print true tabs arg
        | NewTuple(args) ->
            sprintf "("
            + if (args.IsEmpty) then 
                sprintf ")" 
              else
                let mutable acc = print true tabs args.Head
                for expr in args.Tail do
                  acc <- acc + sprintf ","
                  acc <- acc + print true tabs expr
                acc + sprintf ")"
        | TupleGet(e,i) ->
            print true tabs e
            + sprintf ".%d" i
        | Value(null,_) -> sprintf "()"
        | Value(obj,t) -> 
            match obj with
            | :? float32 as val_f -> (sprintf "%s" (val_f.ToString("0.00"))) + "f"
            | :? Boolean as val_b -> sprintf "%s" (val_b.ToString().ToLower())
            | :? (Vector3 list) as v3_lst ->
                let mutable lst = "[new Vector3(" + v3_lst.Head.X.ToString("0.00") + "," + v3_lst.Head.Y.ToString("0.00") + "," + v3_lst.Head.Z.ToString("0.00") + ")"
                for v in v3_lst.Tail do
                  lst <- lst +  ";"
                  lst <- lst + "new Vector3(" + v.X.ToString("0.00") + "f," + v.Y.ToString("0.00") + "f," + v.Z.ToString("0.00") + "f)"
                lst+"]"
            | :? (float32 list) as f_lst ->
                let mutable lst = "["+f_lst.Head.ToString("0.00")
                for f in f_lst.Tail do
                  lst <- lst +  ";"
                  lst <- lst + f.ToString("0.00")
                lst+"]"
            | _ -> sprintf "%s" (obj.ToString())
        | IfThenElse(c,t,e) ->
            sprintf "if "
            + print true (tabs + "  ") c
            + sprintf " then\n%s  " tabs
            + print true (tabs + "  ") t
            + sprintf " \n%selse\n%s  " tabs tabs
            + print true (tabs + "  ") e
        | Sequential(p,q) ->
            sprintf "\n%s" tabs
            + print true tabs p
            + sprintf "\n%s" tabs
            + print true tabs q
        | NewUnionCase(ci,args) ->
            sprintf "%s %s" (if ci.Name = "Empty" then "[]" else ci.Name) (if args |> List.length > 0 then print true "" (Expr.NewTuple(args)) else "")
        | NewRecord (t,e_l) -> 
            let at = t.Attributes
            let tp= t.Assembly.GetType(t.FullName)
            let r_f = FSharpType.GetRecordFields(tp)
            let names = List.zip (r_f.ToFSharplist() |> List.map(fun r_f -> r_f.Name)) e_l
            let record = names |> List.fold (fun s elem -> s + (fst elem) + " = " + (snd elem).ToString() + "; ") ""
            String.Concat ("{",record,"}")                       
        | _ -> failwith "unsupported construct"
    (print true "" expr)    